home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 001-025 / 018 / xlisp1.6 / xldbug.c < prev    next >
C/C++ Source or Header  |  1995-03-13  |  4KB  |  191 lines
  1. /* xldebug - xlisp debugging support */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern long total;
  10. extern int xldebug;
  11. extern int xltrace;
  12. extern int xlsample;
  13. extern NODE *s_unbound;
  14. extern NODE *s_stdin,*s_stdout;
  15. extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
  16. extern NODE ***xlstack;
  17. extern NODE *true;
  18. extern NODE **trace_stack;
  19. extern char buf[];
  20.  
  21. /* external routines */
  22. extern char *malloc();
  23.  
  24. /* forward declarations */
  25. FORWARD NODE *stacktop();
  26.  
  27. /* xlfail - xlisp error handler */
  28. xlfail(emsg)
  29.   char *emsg;
  30. {
  31.     xlerror(emsg,stacktop());
  32. }
  33.  
  34. /* xlabort - xlisp serious error handler */
  35. xlabort(emsg)
  36.   char *emsg;
  37. {
  38.     xlsignal(emsg,s_unbound);
  39. }
  40.  
  41. /* xlbreak - enter a break loop */
  42. xlbreak(emsg,arg)
  43.   char *emsg; NODE *arg;
  44. {
  45.     breakloop("break",NULL,emsg,arg,TRUE);
  46. }
  47.  
  48. /* xlerror - handle a fatal error */
  49. xlerror(emsg,arg)
  50.   char *emsg; NODE *arg;
  51. {
  52.     doerror(NULL,emsg,arg,FALSE);
  53. }
  54.  
  55. /* xlcerror - handle a recoverable error */
  56. xlcerror(cmsg,emsg,arg)
  57.   char *cmsg,*emsg; NODE *arg;
  58. {
  59.     doerror(cmsg,emsg,arg,TRUE);
  60. }
  61.  
  62. /* xlerrprint - print an error message */
  63. xlerrprint(hdr,cmsg,emsg,arg)
  64.   char *hdr,*cmsg,*emsg; NODE *arg;
  65. {
  66.     sprintf(buf,"%s: %s",hdr,emsg); stdputstr(buf);
  67.     if (arg != s_unbound) { stdputstr(" - "); stdprint(arg); }
  68.     else xlterpri(getvalue(s_stdout));
  69.     if (cmsg) { sprintf(buf,"if continued: %s\n",cmsg); stdputstr(buf); }
  70. }
  71.  
  72. /* doerror - handle xlisp errors */
  73. LOCAL doerror(cmsg,emsg,arg,cflag)
  74.   char *cmsg,*emsg; NODE *arg; int cflag;
  75. {
  76.     /* make sure the break loop is enabled */
  77.     if (getvalue(s_breakenable) == NIL)
  78.     xlsignal(emsg,arg);
  79.  
  80.     /* call the debug read-eval-print loop */
  81.     breakloop("error",cmsg,emsg,arg,cflag);
  82. }
  83.  
  84. /* breakloop - the debug read-eval-print loop */
  85. LOCAL int breakloop(hdr,cmsg,emsg,arg,cflag)
  86.   char *hdr,*cmsg,*emsg; NODE *arg; int cflag;
  87. {
  88.     NODE ***oldstk,*expr,*val;
  89.     CONTEXT cntxt;
  90.     int type;
  91.  
  92.     /* print the error message */
  93.     xlerrprint(hdr,cmsg,emsg,arg);
  94.  
  95.     /* flush the input buffer */
  96.     xlflush();
  97.  
  98.     /* do the back trace */
  99.     if (getvalue(s_tracenable)) {
  100.     val = getvalue(s_tlimit);
  101.     xlbaktrace(fixp(val) ? (int)getfixnum(val) : -1);
  102.     }
  103.  
  104.     /* create a new stack frame */
  105.     oldstk = xlsave(&expr,NULL);
  106.  
  107.     /* increment the debug level */
  108.     xldebug++;
  109.  
  110.     /* debug command processing loop */
  111.     xlbegin(&cntxt,CF_ERROR|CF_CLEANUP|CF_CONTINUE,true);
  112.     for (type = 0; type == 0; ) {
  113.  
  114.     /* setup the continue trap */
  115.     if (type = setjmp(cntxt.c_jmpbuf))
  116.         switch (type) {
  117.         case CF_ERROR:
  118.             xlflush();
  119.             type = 0;
  120.             continue;
  121.         case CF_CLEANUP:
  122.             continue;
  123.         case CF_CONTINUE:
  124.             if (cflag) {
  125.             stdputstr("[ continue from break loop ]\n");
  126.             continue;
  127.             }
  128.             else xlabort("this error can't be continued");
  129.         }
  130.  
  131.     /* read an expression and check for eof */
  132.     if (!xlread(getvalue(s_stdin),&expr,FALSE)) {
  133.         type = CF_CLEANUP;
  134.         break;
  135.     }
  136.  
  137.     /* evaluate the expression */
  138.     expr = xleval(expr);
  139.  
  140.     /* print it */
  141.     xlprint(getvalue(s_stdout),expr,TRUE);
  142.     xlterpri(getvalue(s_stdout));
  143.     }
  144.     xlend(&cntxt);
  145.  
  146.     /* decrement the debug level */
  147.     xldebug--;
  148.  
  149.     /* restore the previous stack frame */
  150.     xlstack = oldstk;
  151.  
  152.     /* check for aborting to the previous level */
  153.     if (type == CF_CLEANUP) {
  154.     stdputstr("[ abort to previous level ]\n");
  155.     xlsignal(NULL,NIL);
  156.     }
  157. }
  158.  
  159. /* stacktop - return the top node on the stack */
  160. LOCAL NODE *stacktop()
  161. {
  162.     return (xltrace >= 0 && xltrace < TDEPTH ? trace_stack[xltrace] : s_unbound);
  163. }
  164.  
  165. /* baktrace - do a back trace */
  166. xlbaktrace(n)
  167.   int n;
  168. {
  169.     int i;
  170.  
  171.     for (i = xltrace; (n < 0 || n--) && i >= 0; i--)
  172.     if (i < TDEPTH)
  173.         stdprint(trace_stack[i]);
  174. }
  175.  
  176. /* xldinit - debug initialization routine */
  177. xldinit()
  178. {
  179.     if ((trace_stack = (NODE **)malloc(TDEPTH * sizeof(NODE *))) == NULL) {
  180.     printf("insufficient memory");
  181.     osfinish();
  182.     exit();
  183.     }
  184.     total += (long)(TDEPTH * sizeof(NODE *));
  185.     xlsample = 0;
  186.     xltrace = -1;
  187.     xldebug = 0;
  188. }
  189.  
  190.  
  191.